home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
tjgold.zip
/
INSTALL.001
/
GOLDDATE.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-07-12
|
26KB
|
961 lines
{--------------------------------------------------------------------------}
{ Product: TechnoJock's Turbo Toolkit }
{ Version: GOLD }
{ Build: 1.01 }
{ }
{ Copyright 1986-1995 TechnoJock Software, Inc. }
{ All Rights Reserved }
{ Restricted by License }
{--------------------------------------------------------------------------}
{**********************************}
{** Unit: GOLDDATE **}
{**********************************}
{++++++++++++++++++++++++++++++} unit GOLDDATE; {++++++++++++++++++++++++++++}
{$I GOLDFLAG.INC}
{$IFNDEF GOLDDATE}
{$DEFINE GOLDDATE}
{$ENDIF}
{++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
uses CRT, DOS,
GoldStr, GoldFast, GoldHard, GoldWin;
const AM: string[10] = ' am';
PM: string[10] = ' pm';
CompleteDay = 86400; { number of seconds in 24 hours }
type
Dates = longint;
gDate = (MMDDYY,MMDDYYYY,MMYY,MMYYYY,DDMMYY,DDMMYYYY,YYMMDD,YYYYMMDD);
gTime = (HHMMSS,HHMM);
StrShort = string[20];
gMonths = array[1..12] of StrShort;
gDays = array[0..6] of StrShort;
gHours = array[0..12] of StrShort;
gMinSec = array[0..59] of StrShort;
DATESet = record
ECode: integer;
EMsgFunc: ErrMsgFunc;
LastYearNextCentury: byte;
dSeparator: char;
tSeparator: char;
ClockX: byte;
ClockY: byte;
ClockFB: byte;
end;
const
Days: gDays = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
Months: gMonths = ('January','February','March','April',
'May','June','July','August','September',
'October','November','December');
function LastDateError:integer;
{ Date methods }
function Date:string;
function GregtoJul(M,D,Y:longint):longint;
procedure JultoGreg(Jul:longint; var M,D: word; var Y:longint);
function Day(DStr:string;Format:gDate):word;
function Month(DStr:string;Format:gDate):word;
function Year(DStr:string;Format:gDate):word;
function StrtoJul(DStr:string;Format:gDate):longint;
function DOWNum(DStr:string;Format:gDate):byte;
function DOWStr(DayByte:byte): string;
function DOWJul(Jul:longint):byte;
function GregtoStr(M,D,Y:longint;Format:gDate):string;
function JultoStr(Jul:longint;Format:gDate):string;
function TodayinJul:longint;
function ValidDate(M,D,Y:longint):boolean;
function ValidDateStr(DStr:string;Format:gDate):boolean;
function StripDateStr(DStr:string;Format:gDate):string;
function FancyDateStr(Jul:longint; Long,Day:boolean):string;
function RelativeDate(DStr:string;Format:gDate;Delta:longint):string;
function RelativeDateYMD(DStr:string;Format:gDate;Y,M,D:longint):string;
function StartOfYear(Jul:longint):longint;
function EndOfYear(Jul:longint):longint;
function DateFormat(Format:gDate):string;
function UnformattedDate(InDate:string):string;
{ Time methods }
function Time:string;
procedure Clock;
function Hour(TStr:string;Format:gTime):word;
function Minute(TStr:string;Format:gTime):word;
function Second(TStr:string;Format:gTime):word;
function TimeStrToLong(TStr:string;Format:gTime):longint;
function LongToTimeStr(Secs:longint;Format:gTime;AmPm,Mltry:boolean):string;
function NowInLong:longint;
function ValidTime(Hr,Mn,Sc:longint;Format:gTime;Mltry:boolean):boolean;
function ValidTimeStr(TStr:string;Format:gTime;Mltry:boolean):boolean;
function StripTimeStr(TStr:string;Format:gTime):string;
function TimeToLong(H,M,S:word):longint;
function TimeFormat(Format:gTime):string;
function TimeDiff(StartTime, StopTime: longint): longint;
{$IFDEF TTT5}
function DMY_to_String(D,M,Y:word;format:byte): string;
function Date_To_Julian(InDate:string;format:byte): longint;
function Julian_to_Date(J:longint;format:byte):string;
function Today_in_Julian: longint;
function Date_Within_Range(Min,Max,Test:longint):boolean;
function Valid_Date(Indate:string;format:byte): boolean;
function Future_Date(InDate:string;format:byte;Days:word): string;
function Unformatted_date(InDate:string): string;
{$ENDIF}
var
DateVars: DATESet;
{+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
{$IFOPT F-}
{$DEFINE FOFF}
{$F+}
{$ENDIF}
function DateEMsg(ECode:integer): string;
{}
begin
case Ecode of
0: exit;
1001: DateEMsg := 'DOW number is out-of-range';
1002: DateEMsg := 'Invalid date format';
1003: DateEMsg := 'Invalid time format';
else
DateEMsg := 'Internal date error';
end; {case}
end; { DateEMsg }
{$IFDEF FOFF}
{$F-}
{$UNDEF FOFF}
{$ENDIF}
procedure DateSetError(ECode:integer);
{}
{$IFOPT D+}
var Ch: char;
Msg: string;
{$ENDIF}
begin
DateVars.Ecode := ECode;
{$IFOPT D+} {if debug active display an error message and terminate}
if Ecode <> 0 then
begin
str(Ecode,Msg);
Msg := Msg+': '+DateVars.EMsgFunc(Ecode);
SetWinIgnore(true);
if PromptCustom(' GoldDate Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
Halt;
end;
{$ENDIF}
end; { DateSetError }
function LastDateError: integer;
{}
begin
LastDateError := DateVars.ECode;
end; { LastDateError }
{*********************}
{** Date Routines **}
{*********************}
function Date: String;
{}
var
Y, M, D,
DayOfWeek: word;
Year : string;
Day : string;
begin
GetDate(Y,M,D,DayofWeek);
Str(Y,Year);
Str(D,Day);
Date := Days[DayOfWeek]+' '+Months[M]+' '+Day+', '+Year;
end;
function PadDateStr(DStr:string;Format:gDate):string;
{}
var
Part1,Part2,Part3: string;
L,P: byte;
Sep1,Sep2:char;
procedure PadOut(var S:string; width:byte);
begin
S := padright(S,width,'0');
end; { PadOut }
begin
if length(DStr) = length(DateFormat(Format)) then
begin
PadDateStr := DStr;
exit;
end;
P := 0;
L := length(DStr);
repeat
inc(P);
until (not (DStr[P] in ['0'..'9'])) or (P > L);
if P > L then
begin
PadDateStr := DStr;
exit;
end;
Part1 := copy(DStr,1,pred(P));
Sep1 := DStr[P];
delete(DStr,1,P);
P:= 0;
repeat
inc(P);
until (not (DStr[P] in ['0'..'9'])) or (P > L);
Part2 := copy(DStr,1,pred(P));
Sep2 := DStr[P];
Part3 := copy(DStr,succ(P),4);
case Format of
MMDDYY,YYMMDD,DDMMYY:begin
PadOut(Part1,2);
PadOut(Part2,2);
PadOut(Part3,2);
DStr := Part1+Sep1+Part2+Sep2+Part3;
end;
MMDDYYYY,DDMMYYYY:begin
PadOut(Part1,2);
PadOut(Part2,2);
PadOut(Part3,4);
DStr := Part1+Sep1+Part2+Sep2+Part3;
end;
YYYYMMDD:begin
PadOut(Part1,4);
PadOut(Part2,2);
PadOut(Part3,2);
DStr := Part1+Sep1+Part2+Sep2+Part3;
end;
MMYY:begin
PadOut(Part1,2);
PadOut(Part2,2);
DStr := Part1+Sep1+Part2;
end;
MMYYYY:begin
PadOut(Part1,2);
PadOut(Part2,4);
DStr := Part1+Sep1+Part2;
end;
end; {case}
PadDateStr := DStr;
end; { PadDateStr }
function GregtoJul(M,D,Y:longint):longint;
{}
var Factor: integer;
begin
if M < 3 then
Factor := -1
else
Factor := 0;
GregtoJul := (1461*(Factor+4800+Y) div 4)
+ ((M-2-(Factor*12))*367) div 12
- (3*((Y+4900+Factor) div 100) div 4)
+ D
- 32075;
end; { GregtoJul }
procedure JultoGreg(Jul:longint; var M,D: word; var Y:longint);
{}
var U,V,W,X: longint;
begin
if Jul = 0 then
begin
M := 0;
D := 0;
Y := 0;
end else
begin
inc(Jul,68569);
W := (Jul*4) div 146097;
dec(Jul,((146097*W)+3) div 4);
X := 4000*succ(Jul) div 1461001;
dec(Jul,((1461*X) div 4) - 31);
V := 80*Jul div 2447;
U := V div 11;
D := Jul - (2447*V div 80);
M := V + 2 - (U*12);
Y := X + U + (W-49)*100;
end;
end; { JultoGreg }
function Day(DStr:string;Format:gDate): word;
{}
var
DayStr: string;
begin
DStr := PadDateStr(DStr,Format);
case Format of
MMDDYY,
MMDDYYYY: DayStr := NthNumber(DStr,3)+NthNumber(DStr,4);
DDMMYY,
DDMMYYYY: DayStr := NthNumber(DStr,1)+NthNumber(DStr,2);
YYMMDD: DayStr := NthNumber(DStr,5)+NthNumber(DStr,6);
YYYYMMDD: DayStr := NthNumber(DStr,7)+NthNumber(DStr,8);
else DayStr := '01';
end; {case}
Day := StrToInt(DayStr);
end; { Day }
function Month(DStr:string;Format:gDate): word;
{}
var
MonStr: string;
begin
DStr := PadDateStr(DStr,Format);
case Format of
MMDDYY,
MMDDYYYY,
MMYY,
MMYYYY : MonStr := NthNumber(DStr,1)+NthNumber(DStr,2);
YYMMDD,
DDMMYY,
DDMMYYYY: MonStr := NthNumber(DStr,3)+NthNumber(DStr,4);
YYYYMMDD: MonStr := NthNumber(DStr,5)+NthNumber(DStr,6);
end; {case}
Month := StrToInt(MonStr);
end; { Month }
function Year(DStr:string;Format:gDate): word;
{}
var YrStr: string;
TmpYr: word;
begin
DStr := PadDateStr(DStr,Format);
Case Format of
MMDDYY,
DDMMYY : YrStr := NthNumber(DStr,5)+NthNumber(DStr,6);
MMDDYYYY,
DDMMYYYY : YrStr := NthNumber(DStr,5)+NthNumber(DStr,6)
+ NthNumber(DStr,7)+NthNumber(DStr,8);
MMYY : YrStr := NthNumber(DStr,3)+NthNumber(DStr,4);
MMYYYY : YrStr := NthNumber(DStr,3)+NthNumber(DStr,4)
+ NthNumber(DStr,5)+NthNumber(DStr,6);
YYMMDD : YrStr := NthNumber(DStr,1)+NthNumber(DStr,2);
YYYYMMDD : YrStr := NthNumber(DStr,1)+NthNumber(DStr,2)
+ NthNumber(DStr,3)+NthNumber(DStr,4);
end;
TmpYr := StrToInt(YrStr);
if (TmpYr >= 0) and (TmpYr <= 99) and (length(YrStr) <= 2) then
begin
if TmpYr < DateVars.LastYearNextCentury then
TmpYr := 2000 + TmpYr
else
TmpYr := 1900 + TmpYr;
end;
Year := TmpYr;
end; { Year }
function GregtoStr(M,D,Y:longint;Format:gDate): string;
{}
var
PadChar : char;
DD,MM: string[2];
YY: string[4];
TempStr: string[15];
begin
PadChar := DateVars.dSeparator;
DD := InttoStr(D);
if D < 10 then
DD := '0'+DD;
MM := InttoStr(M);
if M < 10 then
MM := '0'+MM;
if (Format in [MMDDYY,MMYY,DDMMYY,YYMMDD])
and ((Y > 99) or (Y < -99)) then
Y := Y Mod 100;
YY := InttoStr(abs(Y));
if (Y < 10) and (Y > -1) then
YY := '0'+YY;
Case Format of
MMDDYY,
MMDDYYYY: TempStr := MM+PadChar+DD+Padchar+YY;
MMYY,
MMYYYY : TempStr := MM+Padchar+YY;
DDMMYY,
DDMMYYYY: TempStr := DD+PadChar+MM+Padchar+YY;
YYMMDD,
YYYYMMDD: TempStr := YY+PadChar+MM+Padchar+DD;
end; {case}
if Y < 0 then
GregToStr := '-'+TempStr
else
GregToStr := TempStr;
end; { GregtoStr }
function JultoStr(Jul:longint;Format:gDate): string;
{}
var
M,D:word;
Y: longint;
begin
JultoGreg(Jul,M,D,Y);
JultoStr := GregtoStr(M,D,Y,Format);
end; { JultoStr }
function TodayinJul: longint;
{}
var M,D,Y,DOW: word;
begin
GetDate(Y,M,D,DOW);
TodayinJul := GregtoJul(M,D,Y);
end; { TodayinJul }
function LeapYear(Y:longint):boolean;
{}
begin
LeapYear := (Y mod 4 = 0) and ((Y mod 400 = 0) or (Y mod 100 <> 0));
end; { LeapYear }
function ValidDate(M,D,Y:longint):boolean;
{}
begin
if (D < 1)
or (D > 31)
or (M < 1)
or (M > 12)
then
ValidDate := False
else
Case M of
4,6,9,11: ValidDate := (D <= 30);
2: ValidDate := (D <= 28)
or ( (D = 29) and LeapYear(Y));
else ValidDate := true;
end; {case}
end; { ValidDate }
function ValidDateStr(DStr:string;Format:gDate): boolean;
{}
var
M,D,Y: word;
ECount:integer;
begin
ECount := 0;
StrVars.Ecode := 0;
StrVars.SuppressErrors := true;
M := Month(DStr,Format);
inc(ECount,LastStrError);
D := Day(DStr,Format);
inc(ECount,LastStrError);
Y := Year(DStr,Format);
inc(ECount,LastStrError);
if ECount > 0 then
ValidDateStr := false
else
ValidDateStr := ValidDate(M,D,Y);
StrVars.SuppressErrors := false;
end; { ValidDateStr }
function DOWJul(Jul:longint): byte;
var
M,D: word;
Y: longint;
N: longint;
begin
JultoGreg(Jul,M,D,Y);
if M <= 2 then
N := 1461 * (longint(Y)-1) div 4 + 153 * (longint(M)+13) div 5 + longint(D)
else
N := 1461 * longint(Y) div 4 + 153 * (longint(M)+1) div 5 + longint(D);
N:= abs((N - 621049)) mod 7;
DOWJul := N;
end; { DOWJul }
function StrtoJul(DStr:string;Format:gDate):longint;
{}
var
M,D,Y:longint;
begin
M := Month(Dstr,Format);
D := Day(Dstr,Format);
Y := Year(Dstr,Format);
StrtoJul := GregtoJul(M,D,Y);
end; { StrtoJul }
function DOWNum(DStr:string;Format:gDate): byte;
{returns 0 thru 6}
begin
DOWNum := DOWJul(StrtoJul(Dstr,Format));
end; { DOWNum }
function DOWStr(DayByte:byte): string;
{0=Sunday ... 6=Saturday}
begin
if (DayByte in [0..6]) then
DOWStr := Days[DayByte]
else
DateSetError(1001);
end; { DOWStr }
function StripDateStr(DStr:string;Format:gDate):string;
{}
begin
case Format of
MMDDYY,
MMDDYYYY,
DDMMYY,
DDMMYYYY,
YYMMDD: begin
delete(Dstr,3,1);
delete(Dstr,5,1);
end;
MMYY,
MMYYYY : delete(DStr,3,1);
YYYYMMDD: begin
delete(DStr,5,1);
delete(DStr,7,1);
end;
end; {case}
StripDateStr := DStr;
end; { StripDateStr }
function FancyDateStr(Jul:longint; Long,Day:boolean): string;
{}
var
M,D:word;
Y: longint;
TheDay: byte;
Str: string;
begin
JultoGreg(Jul,M,D,Y);
Str := ' '+InttoStr(D)+', '+IntToStr(Y);
if Long then
Str := Months[M] + Str
else
Str := copy(Months[M],1,3) + Str;
if Day then
begin
TheDay := DOWJul(Jul);
if Long then
Str := Days[TheDay] + ' ' + Str
else
Str := copy(Days[TheDay],1,3) + ' ' + Str;
end;
FancyDateStr := Str;
end; { FancyDateStr }
function RelativeDate(DStr:string;Format:gDate;Delta:longint):string;
{Delta is number of days from DStr}
begin
RelativeDate := JultoStr(StrtoJul(DStr,Format)+Delta,Format);
end; { RelativeDate }
function RelativeDateYMD(DStr:string;Format:gDate;Y,M,D:longint):string;
{Y,M,D is number of Years, Months, and Days}
var TmpM,TmpD: word;
TmpY, TmpBase: longint;
begin
JulToGreg(StrToJul(DStr,Format),TmpM,TmpD,TmpY);
TmpY := TmpY + (Y + (M div 12));
inc(TmpM,M mod 12);
TmpBase := GregToJul(TmpM,TmpD,TmpY);
RelativeDateYMD := RelativeDate(JulToStr(TmpBase,Format),Format,D);
end; { RelativeDateYMD }
function EndOfMonth(Jul:longint):longint;
{}
var
M,D:word;
Y: longint;
begin
JultoGreg(Jul,M,D,Y);
case M of
4,6,9,11: D := 30;
2: if (Y mod 4 = 0) and (Y <> 0) and (Y <> 1900) then
D := 29
else
D := 28;
else D := 31;
end; {case}
EndOfMonth := GregtoJul(M,D,Y);
end; { EndOfMonth }
function StartOfMonth(Jul:longint):longint;
{}
var
M,D:word;
Y: longint;
begin
JultoGreg(Jul,M,D,Y);
StartOfMonth := GregtoJul(M,1,Y);
end; { StartOfMonth }
function StartOfYear(Jul:longint):longint;
{}
var
M,D:word;
Y: longint;
begin
JultoGreg(Jul,M,D,Y);
StartOfYear := GregtoJul(1,1,Y);
end; { StartOfYear }
function EndOfYear(Jul:longint):longint;
{}
var
M,D:word;
Y: longint;
begin
JultoGreg(Jul,M,D,Y);
EndOfYear := GregtoJul(12,31,Y);
end; { EndOfYear }
function DateFormat(Format:gDate):string;
{}
begin
with DateVars do
begin
DateFormat := '';
case Format of
MMDDYY: DateFormat := 'MM'+dSeparator+'DD'+dSeparator+'YY';
MMDDYYYY: DateFormat := 'MM'+dSeparator+'DD'+dSeparator+'YYYY';
MMYY: DateFormat := 'MM'+dSeparator+'YY';
MMYYYY: DateFormat := 'MM'+dSeparator+'YYYY';
DDMMYY: DateFormat := 'DD'+dSeparator+'MM'+dSeparator+'YY';
DDMMYYYY: DateFormat := 'DD'+dSeparator+'MM'+dSeparator+'YYYY';
YYMMDD: DateFormat := 'YY'+dSeparator+'MM'+dSeparator+'DD';
YYYYMMDD: DateFormat := 'YYYY'+dSeparator+'MM'+dSeparator+'DD';
else
DateSetError(1002); {Invalid date format}
end; {case}
end;
end; { DateFormat }
function UnformattedDate(InDate:string): string;
{strips all non numeric characters}
var I: Integer;
function Digit(C:char): boolean;
{}
begin
Digit := C in ['0'..'9'];
end; { Digit }
begin
I := 1;
repeat
if (digit(Indate[I]) = false) and (length(Indate) > 0) then
delete(Indate,I,1)
else
I := succ(I);
until (I > length(Indate)) or (Indate = '');
UnformattedDate := Indate;
end; { Unformatteddate }
{*********************}
{** Time Routines **}
{*********************}
function time: string;
{}
var
hour,min,sec: string[2];
tag: string[10];
H,M,S,T : word;
begin
with DateVars do
begin
tag := AM;
GetTime(H,M,S,T);
Str(M,Min);
Str(S,Sec);
if S < 10 then {pad a leading zero if sec is < 10}
sec := '0'+sec;
if M < 10 then {pad a leading zero if min is < 10}
min := '0'+min;
if H > 12 then
begin
dec(H,12);
tag := PM;
end;
time := PadRight(IntToStr(H),2,' ')+tSeparator+min+tSeparator+sec+tag;
end;
end; { Time }
procedure Clock;
{writes current PC time to a predestined location}
begin
with DateVars do
begin
WriteAT(ClockX,ClockY,ClockFB,Time);
end;
end; { Clock }
function Hour(TStr:string;Format:gTime): word;
{}
begin
with DateVars do
begin
Hour := StrToInt(copy(TStr,1,pred(pos(tSeparator,TStr))));
end;
end; { Hour }
function Minute(TStr:string;Format:gTime): word;
{}
var P:byte;
begin
with DateVars do
begin
if Format = HHMMSS then
begin
P := pos(tSeparator,TStr);
Minute := StrToInt(copy(TStr,P,pred(LastPos(tSeparator,TStr)-P)));
end else
Minute := StrToInt(copy(TStr,succ(pos(tSeparator,TStr)),2));
end;
end; { Minute }
function Second(TStr:string;Format:gTime): word;
{}
begin
with DateVars do
begin
if Format = HHMMSS then
Second := StrToInt(copy(TStr,succ(LastPos(tSeparator,TStr)),2))
else Second := 0;
end;
end; { Second }
function TimeStrToLong(TStr:string;Format:gTime):longint;
{}
var Hr,Mn,Sc:longint;
begin
with DateVars do
begin
Hr := Hour(TStr,Format);
Mn := Minute(TStr,Format);
Sc := Second(TStr,Format);
TimeStrToLong := (Hr*3600)+(Mn*60)+Sc;
end;
end; { TimeStrToLong }
function LongToTimeStr(Secs:longint;Format:gTime;AmPm,Mltry:boolean): string;
{}
var Hr,Mn,Sc: word;
HrStr,MnStr,ScStr,Tag: string[3];
begin
with DateVars do
begin
Tag := '';
Hr := Secs div 3600;
if not Mltry then
begin
if Hr > 12 then
begin
Hr := Hr - 12;
If AmPm then
Tag := PM;
end else
if AmPm then
Tag := AM;
end;
HrStr := PadRight(IntToStr(Hr),2,'0');
Mn := (Secs mod 3600) div 60;
MnStr := PadRight(IntToStr(Mn),2,'0');
Sc := Secs mod 60;
ScStr := PadRight(IntToStr(Sc),2,'0');
case Format of
HHMMSS: LongToTimeStr := HrStr+tSeparator+MnStr+tSeparator+ScStr+Tag;
HHMM: LongToTimeStr := HrStr+tSeparator+MnStr+Tag;
end;
end;
end; { LongToTimeStr }
function NowInLong: longint;
{}
var Hr,Mn,Sc,Sc100: word;
begin
gettime(Hr,Mn,Sc,Sc100);
NowInLong := ((longint(Hr) * 3600) + (Mn * 60)) + Sc;
end; { NowInLong }
function ValidTime(Hr,Mn,Sc:longint;Format:gTime;Mltry:boolean):boolean;
{}
begin
with DateVars do
begin
ValidTime := false;
if ((Mltry and (Hr < 24)) or (Hr < 13)) and (Hr >= 0)
and (Mn >= 0) and (Mn < 60)
and (Format = HHMM) or ((Sc >= 0) and (Sc < 60)) then
ValidTime := true;
end;
end; { ValidTime }
function ValidTimeStr(TStr:string;Format:gTime;Mltry:boolean): boolean;
{a valid time string must include a 2 character Hour, Minute,
and Second. It must also contain 2 time separators in positions
3 and 6 with respect given to the appropriate Format}
var Hr,Mn,Sc:word;
begin
with DateVars do
begin
ValidTimeStr := false;
Hr := Hour(TStr,Format);
Mn := Minute(TStr,Format);
Sc := Second(TStr,Format);
if ((Format = HHMMSS) and (length(TStr) = 8)) or
((Format = HHMM) and (length(TStr) = 5)) then
ValidTimeStr := ValidTime(Hr,Mn,Sc,Format,Mltry);
end;
end; { ValidTimeStr }
function StripTimeStr(TStr:string;Format:gTime):string;
{}
begin
with DateVars do
begin
TStr := Strip('A',tSeparator,TStr);
end;
end; { StripTimeStr }
function TimeToLong(H,M,S:word): longint;
{converts H M S to a longint value}
begin
TimeToLong := (H*3600)+(M*60)+S;
end; { TimeToLong }
function TimeFormat(Format:gTime):string;
{}
begin
with DateVars do
begin
TimeFormat := '';
case Format of
HHMMSS: TimeFormat := 'HH'+tSeparator+'MM'+tSeparator+'SS';
HHMM: TimeFormat := 'HH'+tSeparator+'MM';
else
DateSetError(1003); {Invalid time format}
end;
end;
end; { TimeFormat }
function TimeDiff(StartTime, StopTime: longint): longint;
{based on a 24 hour clock}
begin
if ((StartTime >= 0) and (StartTime <= CompleteDay))
and ((StopTime >= 0) and (StopTime <= CompleteDay)) then
begin
if StartTime > StopTime then
TimeDiff := (CompleteDay - StartTime) + StopTime
else
TimeDiff := StopTime - StartTime;
end else
TimeDiff := 0;
end; { TimeDiff }
{**********************************************}
{** U N I T I N I T I A L I Z A T I O N **}
{**********************************************}
procedure DateDefaultSettings;
{}
begin
with DateVars do
begin
LastYearNextCentury := 20;
dSeparator := '/';
tSeparator := ':';
ClockX := 67;
ClockY := 1;
ClockFB := $0F; { white }
end;
end; {DateDefaultSettings}
procedure GoldDATEInit;
{}
begin
DateDefaultSettings;
with DateVars do
begin
EMsgFunc := DateEMsg;
Ecode := 0;
end;
end; {GoldDATEInit}
{$IFDEF TTT5}
function ConvertDateFormat(format:byte): gDate;
{}
var Dfmt: gDate;
begin
case format of
1: Dfmt := MMDDYY;
2: Dfmt := MMDDYYYY;
3: Dfmt := MMYY;
4: Dfmt := MMYYYY;
5: Dfmt := DDMMYY;
6: Dfmt := DDMMYYYY;
7: Dfmt := YYMMDD;
8: Dfmt := YYYYMMDD;
else Dfmt := MMDDYY;
end;
ConvertDateFormat := Dfmt;
end; { ConvertDateFormat }
function DMY_to_String(D,M,Y:word;format:byte): string;
{included for TTT5 compatibility}
begin
DMY_to_String := GregToStr(M,D,Y,ConvertDateFormat(format));
end; { DMY_to_String }
function Date_To_Julian(InDate:string;format:byte): longint;
{included for TTT5 compatibility}
begin
Date_To_Julian := StrToJul(InDate,ConvertDateFormat(format));
end; { Date_To_Julian }
function Julian_to_Date(J:longint;format:byte):string;
{included for TTT5 compatibility}
begin
Julian_to_Date := JulToStr(J,ConvertDateFormat(format));
end; { Julian_to_Date }
function Today_in_Julian: longint;
{included for TTT5 compatibility}
begin
Today_in_Julian := TodayInJul;
end; { Today_in_Julian }
function Date_Within_Range(Min,Max,Test:longint):boolean;
{included for TTT5 compatibility}
begin
Date_Within_Range := ((Test >= Min) and (Test <= Max));
end; { Date_Within_Range }
function Valid_Date(Indate:string;format:byte): boolean;
{included for TTT5 compatibility}
begin
Valid_Date := ValidDateStr(Indate,ConvertDateFormat(format));
end; { Valid_Date }
function Future_Date(InDate:string;format:byte;Days:word): string;
{included for TTT5 compatibility}
begin
Future_Date := RelativeDate(InDate,ConvertDateFormat(format),Days);
end; { Future_Date }
function Unformatted_date(InDate:string): string;
{included for TTT5 compatibility}
begin
Unformatted_date := UnformattedDate(InDate);
end; { Unformatted_date }
{$ENDIF} {TTT5}
begin
GoldDATEInit;
end.